XXVERSION = 3.00MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0 MS Sans Serif, 1, 8, 6, 13, 11, 12, 2, 0 MS Sans Serif, 2, 8, 5, 13, 11, 11, 2, 0 MS Sans Serif, 4, 8, 5, 13, 11, 11, 2, 0  _tbreditingPixelsClass10_toolbar _tbrediting  A%99UiCColors CSet ForeColor... CSet BackColor...TUTHISADDITEM LISTINDEX&%C_SCREEN.ActiveFormbOXT9TdB Hu B  TC%  H  g&%CoControl.ForeColorbNT  c*%CoControl.ItemForeColorbN_T    )C ForeColor TEXTBOX )C ForeColor EDITBOX   C ForeColor    TC%  HJ  1%CoForm.ActiveControl.BackColorbNT  5%C!oForm.ActiveControl.ItemBackColorbNT   d)C BackColor TEXTBOX )C BackColor EDITBOX   C BackColor  TUOFORMOCONTROL NBACKCOLOR NFORECOLOR ACTIVEFORM ACTIVECONTROLTHISVALUETHISFORM NAPPLIESTO FORECOLOR ITEMFORECOLORSETALL BACKCOLOR ITEMBACKCOLORInit,InteractiveChange1e31bAAAAAAAa!!AAABAABAAQQQAAABAAA3%L )WPROCEDURE Init #DEFINE ITEM_COLORS_LOC "Colors" #DEFINE ITEM_FCOLOR_LOC "Set ForeColor..." #DEFINE ITEM_BCOLOR_LOC "Set BackColor..." THIS.AddItem(ITEM_COLORS_LOC) THIS.AddItem(ITEM_FCOLOR_LOC) THIS.AddItem(ITEM_BCOLOR_LOC) THIS.ListIndex = 1 ENDPROC PROCEDURE InteractiveChange LOCAL oForm,oControl,nBackColor,nForeColor IF TYPE("_SCREEN.ActiveForm") = 'O' oForm = _SCREEN.ActiveForm oControl = oForm.ActiveControl ELSE RETURN ENDIF DO CASE CASE This.Value = 1 RETURN CASE This.Value = 2 && Get ForeColor nForeColor = GETCOLOR() IF m.nForeColor > -1 DO CASE CASE THISFORM.nAppliesTo = 1 && current control IF TYPE("oControl.ForeColor") = "N" oControl.ForeColor = m.nForeColor ELSE IF TYPE("oControl.ItemForeColor") = "N" oControl.ItemForeColor = m.nForeColor ENDIF ENDIF CASE THISFORM.nAppliesTo = 2 && text and edit boxes oForm.SetAll('ForeColor', m.nForeColor, 'TEXTBOX') oForm.SetAll('ForeColor', m.nForeColor, 'EDITBOX') CASE THISFORM.nAppliesTo = 3 && All controls oForm.SetAll('ForeColor', m.nForeColor) ENDCASE ENDIF CASE This.Value = 3 && Get BackColor nBackColor = GETCOLOR() IF m.nBackColor > -1 DO CASE CASE THISFORM.nAppliesTo = 1 && current control IF TYPE("oForm.ActiveControl.BackColor") = "N" oForm.ActiveControl.BackColor = m.nBackColor ELSE IF TYPE("oForm.ActiveControl.ItemBackColor") = "N" oForm.ActiveControl.ItemBackColor = m.nBackColor ENDIF ENDIF CASE THISFORM.nAppliesTo = 2 && text and edit boxes oForm.SetAll('BackColor', m.nBackColor, 'TEXTBOX') oForm.SetAll('BackColor', m.nBackColor, 'EDITBOX') CASE THISFORM.nAppliesTo = 3 && All controls oForm.SetAll('BackColor', m.nBackColor) ENDCASE ENDIF ENDCASE THIS.Value = 1 ENDPROC FontBold = .F. FontName = "MS Sans Serif" FontSize = 8 Value = 0 Height = 22 Left = 265 Style = 2 ToolTipText = "ForeColor and BackColor" Top = 5 Width = 69 Name = "cboColor"  _tbreditingcboColorcombobox _base.vcx _comboboxBTop = 5 Left = 265 Height = 22 Width = 0 Name = "Separator2"  _tbrediting Separator2 separator separator %<Uq&%C_SCREEN.ActiveFormbO<T9HB HYj 5%C!oForm.ActiveControl.FontUnderlinebUT 0-C FontUnderlineTEXTBOX-C FontUnderlineEDITBOX j#C FontUnderlineU OFORM ACTIVEFORMTHISPARENT NAPPLIESTO ACTIVECONTROL FONTUNDERLINEVALUESETALLInteractiveChange,1qbAAqQaAqr1A2U)`PROCEDURE InteractiveChange LOCAL oForm IF TYPE("_SCREEN.ActiveForm") = 'O' oForm = _SCREEN.ActiveForm ELSE RETURN ENDIF DO CASE CASE THIS.Parent.nAppliesTo = 1 && Current Control IF TYPE("oForm.ActiveControl.FontUnderline") #"U" oForm.ActiveControl.FontUnderline = THIS.Value ENDIF CASE THIS.Parent.nAppliesTo = 2 && All textboxes and editboxes oForm.SetAll('FontUnderline', THIS.Value, 'TEXTBOX') oForm.SetAll('FontUnderline', THIS.Value, 'EDITBOX') CASE THIS.Parent.nAppliesTo = 3 && All Controls oForm.SetAll('FontUnderline', THIS.Value) ENDCASE ENDPROC Top = 5 Left = 234 Height = 22 Width = 26 FontName = "MS Sans Serif" FontSize = 8 FontUnderline = .T. Caption = "U" Value = .F. Style = 1 ToolTipText = "Underline" Name = "chkUnderline"  _tbrediting chkUnderlinecheckbox _base.vcx _checkbox vvi%-Ue&%C_SCREEN.ActiveFormbO<T9HB HY^ 2%CoForm.ActiveControl.FontItalicbUT '*C FontItalicTEXTBOX*C FontItalicEDITBOX ^ C FontItalicU OFORM ACTIVEFORMTHISPARENT NAPPLIESTO ACTIVECONTROL FONTITALICVALUESETALLInteractiveChange,1qbAAq!aAqrB2H)vSPROCEDURE InteractiveChange LOCAL oForm IF TYPE("_SCREEN.ActiveForm") = 'O' oForm = _SCREEN.ActiveForm ELSE RETURN ENDIF DO CASE CASE THIS.Parent.nAppliesTo = 1 && Current Control IF TYPE("oForm.ActiveControl.FontItalic")#"U" oForm.ActiveControl.FontItalic = THIS.Value ENDIF CASE THIS.Parent.nAppliesTo = 2 && All textboxes and editboxes oForm.SetAll('FontItalic', THIS.Value, 'TEXTBOX') oForm.SetAll('FontItalic', THIS.Value, 'EDITBOX') CASE THIS.Parent.nAppliesTo = 3 && All Controls oForm.SetAll('FontItalic', THIS.Value) ENDCASE ENDPROC Top = 5 Left = 209 Height = 22 Width = 26 FontItalic = .T. FontName = "MS Sans Serif" FontSize = 8 Caption = "I" Value = .F. Style = 1 ToolTipText = "Italic" Name = "chkItalic"  _tbrediting chkItaliccheckbox _base.vcx _checkbox ll%#U]&%C_SCREEN.ActiveFormbO<T9HB HYV 0%CoForm.ActiveControl.FontBoldbUT !(CFontBoldTEXTBOX(CFontBoldEDITBOX VCFontBoldU OFORM ACTIVEFORMTHISPARENT NAPPLIESTO ACTIVECONTROLFONTBOLDVALUESETALLInteractiveChange,1qbAAqaArrA2?)lJPROCEDURE InteractiveChange LOCAL oForm IF TYPE("_SCREEN.ActiveForm") = 'O' oForm = _SCREEN.ActiveForm ELSE RETURN ENDIF DO CASE CASE THIS.Parent.nAppliesTo = 1 && Current Control IF TYPE("oForm.ActiveControl.FontBold")#"U" oForm.ActiveControl.FontBold = THIS.Value ENDIF CASE THIS.Parent.nAppliesTo = 2 && All textboxes and editboxes oForm.SetAll('FontBold', THIS.Value, 'TEXTBOX') oForm.SetAll('FontBold', THIS.Value, 'EDITBOX') CASE THIS.Parent.nAppliesTo = 3 && All Controls oForm.SetAll('FontBold', THIS.Value) ENDCASE ENDPROC Top = 5 Left = 184 Height = 22 Width = 26 FontBold = .T. FontName = "MS Sans Serif" FontSize = 8 Caption = "B" Value = .F. Style = 1 ToolTipText = "Bold" Name = "chkBold"  _tbreditingchkBoldcheckbox _base.vcx _checkboxBTop = 5 Left = 184 Height = 22 Width = 0 Name = "Separator1"  _tbrediting Separator1 separator separator %t($U  H' YBR,2The control doesn't support the selected fontsize.8%C$Application.ActiveForm.ActiveControlbOC 2fTError Number: CCZC C Error Message: CEC C  Procedure: CtTC2x H_ v  X2BU NERRORCMETHODNLINELCMSGLNANSWERTHISPARENTREFRESH APPLICATION ACTIVEFORM ACTIVECONTROLe&%C_SCREEN.ActiveFormbO<T9HB HY^ 0%CoForm.ActiveControl.FontsizebUTCg '*CFontSizeCgTEXTBOX*CFontSizeCgEDITBOX ^ CFontSizeCgU OFORM ACTIVEFORMTHISPARENT NAPPLIESTO ACTIVECONTROLFONTSIZEVALUESETALLError,InteractiveChange<1!!AfA1A1AAAA3qaAAqArrB2.d%)oPROCEDURE Error LPARAMETERS nError, cMethod, nLine #define NUM_LOC "Error Number: " #define PROG_LOC "Procedure: " #define MSG_LOC "Error Message: " #define CR_LOC CHR(13) #define BADSIZE_LOC "The control doesn't support the selected fontsize." LOCAL lcMsg,lnAnswer DO CASE CASE nError = 1881 && Fontsize invalid for the control WAIT WINDOW BADSIZE_LOC TIMEOUT 2 IF TYPE("Application.ActiveForm.ActiveControl") = "O" THIS.Parent.Refresh(Application.ActiveForm.ActiveControl) ENDIF OTHERWISE *----------------------------------------------------------- * Display information about an unanticipated error. *----------------------------------------------------------- lcMsg = NUM_LOC + ALLTRIM(STR(nError)) + CR_LOC + CR_LOC + ; MSG_LOC + MESSAGE( )+ CR_LOC + CR_LOC + ; PROG_LOC + PROGRAM(1) lnAnswer = MESSAGEBOX(lcMsg, 2+48+512) DO CASE CASE m.lnAnswer = 3 &&Abort CANCEL CASE m.lnAnswer = 4 &&Retry RETRY OTHERWISE RETURN ENDCASE ENDCASE ENDPROC PROCEDURE InteractiveChange LOCAL oForm IF TYPE("_SCREEN.ActiveForm") = "O" oForm = _SCREEN.ActiveForm ELSE RETURN ENDIF DO CASE CASE THIS.Parent.nAppliesTo = 1 && Current Control IF TYPE("oForm.ActiveControl.Fontsize") # "U" oForm.ActiveControl.FontSize = VAL(THIS.Value) ENDIF CASE THIS.Parent.nAppliesTo = 2 && All textboxes and editboxes oForm.SetAll('FontSize', VAL(THIS.Value), 'TEXTBOX') oForm.SetAll('FontSize', VAL(THIS.Value), 'EDITBOX') CASE THIS.Parent.nAppliesTo = 3 && All Controls oForm.SetAll('FontSize', VAL(THIS.Value)) ENDCASE ENDPROC _FontName = "MS Sans Serif" FontSize = 8 Height = 22 Left = 135 Top = 5 Name = "cboSizes"  _tbreditingcboSizescombobox _format.vcx _cbofontsizeBTop = 5 Left = 135 Height = 22 Width = 0 Name = "Separator3"  _tbrediting Separator3 separator separator %c~U T%C_SCREEN.ActiveFormbO+C _SCREEN.ActiveForm.ActiveControlbO ~T9TB H %CFontnamehT N(CFontNameTEXTBOX (CFontNameEDITBOX  CFontName C C U OFORMOCONTROL ACTIVEFORM ACTIVECONTROLTHISPARENT NAPPLIESTOFONTNAMEVALUESETALLCBOSIZESFILLLISTREFRESHInteractiveChange,1AAAq1ArqBA2\)gPROCEDURE InteractiveChange LOCAL oForm, oControl IF TYPE("_SCREEN.ActiveForm") = "O" AND TYPE("_SCREEN.ActiveForm.ActiveControl") = "O" oForm = _SCREEN.ActiveForm oControl = oForm.ActiveControl ELSE RETURN ENDIF DO CASE CASE THIS.Parent.nAppliesTo = 1 && Current Control IF PEMSTATUS(oControl,'Fontname',5) oControl.FontName = This.Value ENDIF CASE THIS.Parent.nAppliesTo = 2 && All textboxes and editboxes oForm.SetAll('FontName', This.Value, 'TEXTBOX') oForm.SetAll('FontName', This.Value, 'EDITBOX') *================================================================== * comment out the previous 2 lines and uncomment the following lines * if you want to affect all controls with a baseclass of textbox * or editbox. *------------------------------------------------------------------ *FOR i = 1 to oForm.ControlCount * * IF UPPER(oForm.Controls(i).BaseClass) = 'TEXTBOX' OR ; * UPPER(oForm.Controls(i).BaseClass) = 'EDITBOX' * oForm.Controls(i).FontName = THIS.Value * ENDIF *ENDFOR *================================================================== CASE THIS.Parent.nAppliesTo = 3 && All Controls oForm.SetAll('FontName', This.Value) ENDCASE THIS.Parent.cboSizes.FillList(THIS.Value) THIS.Parent.Refresh(oControl) ENDPROC jFontName = "MS Sans Serif" FontSize = 8 Height = 22 Left = 5 Top = 5 Width = 125 Name = "cboFonts"  _tbreditingcboFontscombobox _format.vcx _cbofontnameInappliesto 1 - applies to current control. 3 - applies to all controls. i PPc%%UT-UTHISVISIBLEc H\ &%C_SCREEN.ActiveFormbOdT9pB(|+%CTextbox Editboxx T C  C  "T CC Z T C  T C  T C !2\%CoSourcebOB$%CoSource.FontNamebUXT  C  T CZT T T UOSOURCEITHIS NAPPLIESTOOFORM ACTIVEFORM CONTROLCOUNTCONTROLS BASECLASSCBOFONTSVALUEFONTNAMECBOSIZESFILLLISTFONTSIZECHKBOLDFONTBOLD CHKITALIC FONTITALIC CHKUNDERLINE FONTUNDERLINEDestroy,RefreshP13qrAaAA!AAAAAAaaaaAA1'E[)Ptoolbar _base.vcx _format.vcxcombobox Cbofontnames _rtfcontrols _base.vcxcomboboxLFontBold = .F. Height = 25 Style = 2 Width = 217 Name = "_cbofontname" PROCEDURE Init LOCAL aFontNames,i DIMENSION aFontNames[1] =afont(aFontNames) FOR i = 1 TO ALEN(aFontNames) THIS.AddItem(aFontNames[m.i]) ENDFOR THIS.Value = THIS.FontName ENDPROC R 99% Uq  C((CWCC TU AFONTNAMESITHISADDITEMVALUEFONTNAMEInit,1qA11)9 _cbofontname _combobox1ClassPixels _cbofontname!Arial, 0, 9, 5, 15, 12, 21, 3, 0  _base.vcx containerBWidth = 311 Height = 32 BorderWidth = 0 Name = "_rtfcontrols"  _cbofontname!Arial, 0, 9, 5, 15, 12, 21, 3, 0  _cbofontsizePixels7displays the font sizes available for a particular fontClass1 _combobox _cbofontsizensmallestfont For scalable fonts, smallest allowable fontsize. nlargestfont For scalable fonts, specifies the largest allowable fontsize. *filllist  i%f# U # T-%C [T T C(%C TaT T TC T T- ( *T C  C _ CC _6C %  T a %C L  T C )T C   C 6U CFONTNAME LAUTORESETASIZES LSCALABLENLENNSTARTI LFOUNDFONT CSAVEVALUE CFONTSIZETHISVALUECLEAR NLARGESTFONT NSMALLESTFONTADDITEMLISTCaUTHISFILLLISTFONTNAMEfilllist,Init12"AaA1QAAqA3A2F!a*)PROCEDURE filllist LPARAMETERS cFontName,lAutoReset LOCAL aSizes,lScalable,nLen,nStart,i,lfoundfont,cSaveValue,cFontSize lfoundfont = .F. IF EMPTY(THIS.Value) THIS.Value = "" ENDIF cSaveValue = THIS.Value THIS.Clear DIMENSION aSizes[1] =AFONT(aSizes, cFontname) IF aSizes[1] = -1 && The font is scalable lScalable = .T. nLen = THIS.nLargestFont nStart = THIS.nSmallestFont ELSE nLen = ALEN(aSizes) nStart = 1 lScalable = .F. ENDIF FOR i = m.nStart TO m.nLen cFontSize = IIF(m.lScalable,TRANS(m.i),TRANS(aSizes[m.i])) THIS.AddItem(m.cFontSize) IF m.cFontSize == m.cSaveValue m.lfoundfont = .T. ENDIF ENDFOR IF VARTYPE(m.lAutoReset)="L" AND m.lAutoReset THIS.Value = THIS.List[1] ELSE * Check if font already set THIS.Value = IIF(m.lFoundFont,m.cSaveValue,THIS.List[1]) ENDIF ENDPROC PROCEDURE Init THIS.filllist(THIS.FontName,.T.) ENDPROC FontBold = .F. Height = 25 Style = 2 ToolTipText = "FontSize" Width = 44 nsmallestfont = 8 nlargestfont = 48 Name = "_cbofontsize" combobox _base.vcxnArial, 0, 9, 5, 15, 12, 21, 3, 0 Courier New, 1, 9, 7, 16, 12, 9, 4, 0 Courier New, 3, 9, 7, 16, 12, 11, 4, 0  _rtfcontrolsPixelsClass6 _container _rtfcontrols|Top = 4 Left = 283 Height = 23 Width = 25 Caption = "C" ToolTipText = "Color" ForeColor = 255,0,0 Name = "cmdColor"  _rtfcontrolscmdColor commandbutton _base.vcx_commandbuttonTop = 4 Left = 255 Height = 23 Width = 25 FontBold = .T. FontItalic = .T. FontName = "Courier New" FontSize = 9 Caption = "I" ToolTipText = "Italic" Name = "cmdItalic"  _rtfcontrols cmdItalic commandbutton _base.vcx_commandbuttonTop = 4 Left = 227 Height = 23 Width = 25 FontBold = .T. FontName = "Courier New" Caption = "B" ToolTipText = "Bold" Name = "cmdBold"  _rtfcontrolscmdBold commandbutton _base.vcx_commandbutton,Left = 172 Top = 4 Name = "Cbofontsizes"  _rtfcontrols Cbofontsizescombobox _format.vcx _cbofontsize %yUCUTHISPARENT CBOFONTSIZESFILLLISTVALUEInteractiveChange,12L)WPROCEDURE InteractiveChange THIS.Parent.cboFontSizes.FillList(THIS.Value) ENDPROC DHeight = 25 Left = 4 Top = 4 Width = 157 Name = "Cbofontnames" fPROCEDURE Destroy This.Visible = .F. ENDPROC PROCEDURE Refresh LPARAMETERS oSource LOCAL i DO CASE CASE THIS.nAppliesTo = 2 && text and edit boxes IF TYPE("_SCREEN.ActiveForm") = 'O' oForm = _SCREEN.ActiveForm ELSE RETURN ENDIF FOR i = 1 to oForm.ControlCount IF oForm.Controls(i).BaseClass$"Textbox Editbox" THIS.cboFonts.Value = oForm.Controls(m.i).FontName THIS.cboSizes.FillList(THIS.cboFonts.Value) THIS.cboSizes.Value = STR(oForm.Controls(m.i).FontSize) THIS.chkBold.Value = oForm.Controls(m.i).FontBold THIS.chkItalic.Value = oForm.Controls(m.i).FontItalic THIS.chkUnderline.Value = oForm.Controls(m.i).FontUnderline EXIT ENDIF ENDFOR OTHERWISE IF TYPE("oSource") != 'O' RETURN ENDIF IF TYPE("oSource.FontName") #"U" THIS.cboFonts.Value = oSource.FontName THIS.cboSizes.FillList(THIS.cboFonts.Value) THIS.cboSizes.Value = STR(oSource.FontSize) THIS.chkBold.Value = oSource.FontBold THIS.chkItalic.Value = oSource.FontItalic THIS.chkUnderline.Value = oSource.FontUnderline ENDIF ENDCASE ENDPROC hCaption = "Editing" Height = 31 Left = 0 Top = 0 Width = 339 nappliesto = 1 Name = "_tbrediting"